package SweetPea::Shell;

use warnings;
use strict;

=head1 NAME

SweetPea::Shell - The SweetPea HTTP, Security and Gateway Interface!

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.01';

sub new {
    my ($class, $base) = @_;
    my $self  = bless {}, $class;
       $self->{base} = $base;
    return $self;
}

=head1 SYNOPSIS

    use SweetPea::Shell;

    my $sp->{'.shell'} = SweetPea::Shell->new();
    ...

=head1 FUNCTIONS

=head2 self_check

This function verifies that all the required elements are in place to ensure a happy execution

=cut

sub self_check {
    my $self = shift;
    my $base = $self->{base};
    
    # check manifest if available
    my $path = $base->application->{path};
    if ( -e "$path/manifest" )
    {
        open MF, "$path/manifest" or die print "Error reading $path/manifest, $!";
        my @files_and_dirs = <MF>;
        close MF or die print "Error closing $path/manifest, $!";
        foreach (@files_and_dirs)
        {
            chomp;
            my $file = "$path/$_";
            warn "$_ is not accessible.\n" unless -e $file || $file =~ /\.make/;
        }
    }
    # warn about the danger of leaving .make on a production system
    warn ".make should be removed after development.\n" if -e "$path/.make";
    return $self;
}

=head2 init_dispatcher

=cut

sub init_dispatcher {
    my $self     = shift;
    my $base     = $self->{base}; $base->{'.cgi'} = CGI->new;
    
    my %dispatch = %{$base->roots->load_path_and_actions()};
    my $path     = $base->cgi->path_info();
       $path     =~ s/^\/\.app//;
    my $handler  = $dispatch{$path};
    
    #set uri vars
    my $bse_path = $ENV{SCRIPT_NAME};
       $bse_path =~ s/\.app$//;
       $bse_path =~ s/sweet\/.*$// if $bse_path =~ m/sweet\//;
    my $cur_path = $base->cgi->url();
       $cur_path =~ s/\.app//;
       $cur_path = $cur_path . '/' . ($path =~ m/\/(.*)/)[0] if $path;
       $cur_path =~ s/.*($bse_path.*)$/$1/;
       
       $base->application->{'url'}->{root} = $bse_path;
       $base->application->{'url'}->{here} = $cur_path;
    
    # set default action if action not defined
    unless ( exists $dispatch{$path} )
    {  
        $handler = $dispatch{"$path/index"} if exists $dispatch{"$path/index"};
        $handler = $dispatch{"/root/index"} if exists $dispatch{"/root/index"} && !$dispatch{"$path/index"};
    }
    
    if (ref($handler) eq "CODE")
    {
        #run user-defined begin routine or default to root begin
        $dispatch{"/root/begin"}->($base) if exists $dispatch{"/root/begin"};
        $dispatch{"$path/begin"}->($base) if exists $dispatch{"$path/begin"};
        #run user-defined response routines
        $handler->($base);
        #run user-defined end routine or default to root end
        $dispatch{"$path/end"}->($base) if exists $dispatch{"$path/end"};
        $dispatch{"/root/end"}->($base) if exists $dispatch{"/root/end"};
        #run pre-defined response routines
        $base->start();
        #run finalization and cleanup routines
        $base->finish();
    }
    else
    {
        print "HTTP/1.0 404 Not found\r\n";
        print $base->cgi->header, $base->cgi->start_html('Not found'), $base->cgi->h1('Not found'), $base->cgi->end_html;
    }
}

=head2 init_server

This function starts the http server which handles all application requests

=cut

sub init_server {
    my $self = shift;
    my $base = $self->{base};
    {
        package SweetPea::Shell::Server;
        use base 'HTTP::Server::Simple::CGI';
        
        # start the http server on port 3000 or a user-defined port
        our $base    = $self->{base}; $base->application->{http_server}->{on} = 1;
        our $port    = $base->store->{http_server}->{port} || 8090;
        our %actions = %{$base->roots->load_path_and_actions()};
        
        sub handle_request
        {
            my $self        = shift;
            my $cgi         = shift;
            my %dispatch    = %actions;
            my $path        = $cgi->path_info();
            my $handler     = $dispatch{$path};
        
            # add cgi ref to base
            $base->{'.cgi'} = $cgi;
            
            #set uri vars
            $base->application->{'url'}->{root} = '/';
            $base->application->{'url'}->{here} = $path;
        
            unless ( exists $dispatch{$path} )
            {
                $handler = $dispatch{"$path/index"} if exists $dispatch{"$path/index"};
                $handler = $dispatch{"/root/index"} if exists $dispatch{"/root/index"} && !$dispatch{"$path/index"};
            }
            
            if (ref($handler) eq "CODE")
            {
                #run user-defined begin routine or default to root begin
                $dispatch{"/root/begin"}->($base) if exists $dispatch{"/root/begin"};
                $dispatch{"$path/begin"}->($base) if exists $dispatch{"$path/begin"};
                #run user-defined response routines
                $handler->($base);
                #run user-defined end routine or default to root end
                $dispatch{"$path/end"}->($base) if exists $dispatch{"$path/end"};
                $dispatch{"/root/end"}->($base) if exists $dispatch{"/root/end"};
                #run pre-defined response routines
                $base->start();
                #run finalization and cleanup routines
                $base->finish();
            }
            else
            {
                print "HTTP/1.0 404 Not found\r\n";
                print $cgi->header, $cgi->start_html('Not found'), $cgi->h1('Not found'), $cgi->end_html;
            }
        }
        
        my $proc = SweetPea::Shell::Server->new($port)->background();
        print "The SweetPea server has started, use 'kill $proc' or Crtl+C to stop the server.\n";
    }
}

=head1 AUTHOR

Al Newkirk, C<< <al.newkirk at awnstudio.com> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-sweetpea-shell at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=SweetPea-Shell>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc SweetPea::Shell


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=SweetPea-Shell>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/SweetPea-Shell>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/SweetPea-Shell>

=item * Search CPAN

L<http://search.cpan.org/dist/SweetPea-Shell/>

=back


=head1 ACKNOWLEDGEMENTS


=head1 COPYRIGHT & LICENSE

Copyright 2009 Al Newkirk, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.


=cut

1; # End of SweetPea::Shell
